home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / serialize.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  3.8 KB  |  115 lines
  1. ;;;;     Copyright (C) 2003, 2006 Free Software Foundation, Inc.
  2. ;;;;
  3. ;;;; This library is free software; you can redistribute it and/or
  4. ;;;; modify it under the terms of the GNU Lesser General Public
  5. ;;;; License as published by the Free Software Foundation; either
  6. ;;;; version 2.1 of the License, or (at your option) any later version.
  7. ;;;; 
  8. ;;;; This library is distributed in the hope that it will be useful,
  9. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11. ;;;; Lesser General Public License for more details.
  12. ;;;; 
  13. ;;;; You should have received a copy of the GNU Lesser General Public
  14. ;;;; License along with this library; if not, write to the Free Software
  15. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16. ;;;;
  17.  
  18. ;;; Commentary:
  19.  
  20. ;; (serialize FORM1 ...) and (parallelize FORM1 ...) are useful when
  21. ;; you don't trust the thread safety of most of your program, but
  22. ;; where you have some section(s) of code which you consider can run
  23. ;; in parallel to other sections.
  24. ;;
  25. ;; They "flag" (with dynamic extent) sections of code to be of
  26. ;; "serial" or "parallel" nature and have the single effect of
  27. ;; preventing a serial section from being run in parallel with any
  28. ;; serial section (including itself).
  29. ;;
  30. ;; Both serialize and parallelize can be nested.  If so, the
  31. ;; inner-most construct is in effect.
  32. ;;
  33. ;; NOTE 1: A serial section can run in parallel with a parallel
  34. ;; section.
  35. ;;
  36. ;; NOTE 2: If a serial section S is "interrupted" by a parallel
  37. ;; section P in the following manner: S = S1 P S2, S2 is not
  38. ;; guaranteed to be resumed by the same thread that previously
  39. ;; executed S1.
  40. ;;
  41. ;; WARNING: Spawning new threads within a serial section have
  42. ;; undefined effects.  It is OK, though, to spawn threads in unflagged
  43. ;; sections of code where neither serialize or parallelize is in
  44. ;; effect.
  45. ;;
  46. ;; A typical usage is when Guile is used as scripting language in some
  47. ;; application doing heavy computations.  If each thread is
  48. ;; encapsulated with a serialize form, you can then put a parallelize
  49. ;; form around the code performing the heavy computations (typically a
  50. ;; C code primitive), enabling the computations to run in parallel
  51. ;; while the scripting code runs single-threadedly.
  52. ;; 
  53.  
  54. ;;; Code:
  55.  
  56. (define-module (ice-9 serialize)
  57.   :use-module (ice-9 threads)
  58.   :export (call-with-serialization
  59.        call-with-parallelization)
  60.   :export-syntax (serialize
  61.           parallelize))
  62.  
  63.  
  64. (define serialization-mutex (make-mutex))
  65. (define admin-mutex (make-mutex))
  66. (define owner #f)
  67.  
  68. (define (call-with-serialization thunk)
  69.   (let ((outer-owner #f))
  70.     (dynamic-wind
  71.     (lambda ()
  72.       (lock-mutex admin-mutex)
  73.       (set! outer-owner owner)
  74.       (if (not (eqv? outer-owner (dynamic-root)))
  75.           (begin
  76.         (unlock-mutex admin-mutex)
  77.         (lock-mutex serialization-mutex)
  78.         (set! owner (dynamic-root)))
  79.           (unlock-mutex admin-mutex)))
  80.     thunk
  81.     (lambda ()
  82.       (lock-mutex admin-mutex)
  83.       (if (not (eqv? outer-owner (dynamic-root)))
  84.           (begin
  85.         (set! owner #f)
  86.         (unlock-mutex serialization-mutex)))
  87.       (unlock-mutex admin-mutex)))))
  88.  
  89. (define-macro (serialize . forms)
  90.   `(call-with-serialization (lambda () ,@forms)))
  91.  
  92. (define (call-with-parallelization thunk)
  93.   (let ((outer-owner #f))
  94.     (dynamic-wind
  95.     (lambda ()
  96.       (lock-mutex admin-mutex)
  97.       (set! outer-owner owner)
  98.       (if (eqv? outer-owner (dynamic-root))
  99.           (begin
  100.         (set! owner #f)
  101.         (unlock-mutex serialization-mutex)))
  102.       (unlock-mutex admin-mutex))
  103.     thunk
  104.     (lambda ()
  105.       (lock-mutex admin-mutex)
  106.       (if (eqv? outer-owner (dynamic-root))
  107.           (begin
  108.         (unlock-mutex admin-mutex)
  109.         (lock-mutex serialization-mutex)
  110.         (set! owner outer-owner))
  111.           (unlock-mutex admin-mutex))))))
  112.  
  113. (define-macro (parallelize . forms)
  114.   `(call-with-parallelization (lambda () ,@forms)))
  115.